home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / EDIT_UTL / OBINED / OBINED.PAS next >
Pascal/Delphi Source File  |  1991-03-04  |  33KB  |  948 lines
  1. {
  2.             ┌────────────────────────────────────────────┐
  3.             │               OBINED.PAS                   │
  4.             │    Object oriented for Version 6 Pascal    │
  5.             │   plus Kim Kokkonen's event handler tweak  │
  6.             │         see credits after end.             │
  7.             ╞════════════════════════════════════════════╡
  8.             │  Vince Risi : Prodigy Computing (PTY) Ltd. │
  9.             │         Compuserve [72427,3434]            │
  10.             │    Johannesburg, South Africa  886-7122    │
  11.             └────────────────────────────────────────────┘
  12.  
  13.   ┌───────────────────────────────────────────────────────────────────────┐
  14.   │You will need BINED.OBJ and EVENT.OBJ from the version 4 editor toolbox│
  15.   │in order to compile this to a .tpu.                                    │
  16.   └───────────────────────────────────────────────────────────────────────┘
  17.  
  18. }
  19. {$A-}
  20. {$I-}
  21. {$S-}
  22. {$R-}
  23.  
  24. unit obined;
  25. {-The binary editor (of Borland) interface for Turbo Pascal version 6}
  26. interface
  27.  
  28. const
  29.   MaxFileSize   = $FFE0;        {Maximum file size editable by Binary Editor}
  30.   EdOptInsert   = $1;           {Insert on flag}
  31.   EdOptIndent   = $2;           {Autoindent on flag}
  32.   EdOptTAB      = $8;           {Tab on flag}
  33.   EdOptBlock    = $10;          {Show marked block}
  34.   EdOptNoUpdate = $20;          {Don't update screen when entering editor}
  35.   EventKBflag = 1;              {Scroll, num or caps locks modified mask}
  36.   CAnorm = #255#1;              {Activates CRT "normal" attribute}
  37.   CAlow  = #255#2;              {Activates CRT "low"        -    }
  38.   CAblk  = #255#3;              {Activates CRT "block"      -    }
  39.   CAerr  = #255#4;              {Activates CRT "error"      -    }
  40.   EdStatTextMod = 1;            {Text buffer modified mask}
  41.  
  42. type
  43.    AttrArray  = array[0..3] of Byte;
  44.    ASCIIZ     = array[0..255] of Char;
  45.    ASCIIZptr  = ^ASCIIZ;
  46.    TextBuffer = array[0..$FFF0] of Char;
  47.  
  48.    EdintRecP = ^EdIntRec;
  49.    EdIntRec = object
  50.       function CurrLineOfs : Word;
  51.         {-Return text buffer offset at start of current line}
  52.       function CurrChar : Char;
  53.         {-Return character at cursor position}
  54.       function LinePos : Byte;
  55.         {-Return cursor position within current line, 1..247}
  56.       function LineLen : Byte;
  57.         {-Return length of current line}
  58.       function CurrLine : string;
  59.         {-Return the current line as a string}
  60.       function EditOptions : Byte;
  61.         {-Return the current editor options}
  62.       procedure ClearKbd;
  63.         {-Clears both the BIOS and internal BINED keyboard buffers}
  64.       procedure StuffKey(W : Word);
  65.         {-Stuffs a keystroke into the keyboard buffer}
  66.    private
  67.       EditSeg : Word;             {Segment where editor control block is located}
  68.       BuffOfs : Word;             {Offset in EditSeg where text buffer starts}
  69.       LineOfs : Word;             {Offset in EditSeg where offset of current line is stored}
  70.       StrtOfs : Word;             {Offset in EditSeg where line buffer is stored}
  71.       CurrOfs : Word;             {Offset in EditSeg where offset of position in line buffer is stored}
  72.       CharOfs : Word;             {Offset in EditSeg of character buffer}
  73.       OptnOfs : Word;             {Offset in EditSeg of editor options}
  74.       procedure Find(var EdD);
  75.          {-Initialize an internal data record}
  76.    end;
  77.  
  78.    CRTinsStruct = record
  79.       CRTtype : Byte;           {1=IBM, 0=Non}
  80.       CRTx1, CRTy1,
  81.       CRTx2, CRTy2 : Byte;      {Initial window size}
  82.       CRTmode : Byte;           {Initial mode 0-3,7 or FF(default)}
  83.       CRTsnow : Byte;           {0 if no snow, don't care for mono}
  84.       AttrMono : AttrArray;     {CRT attributes for mono mode}
  85.       AttrBW : AttrArray;       {CRT attributes for b/w modes}
  86.       AttrColor : AttrArray;    {CRT attributes for color modes}
  87.    end;
  88.    CIptr = ^CRTinsStruct;
  89.  
  90.    EdInsStruct = record
  91.       ComTablen : Word;         {Maximum length of command table}
  92.       ComTab : TextBuffer;      {Command table}
  93.    end;
  94.    EIptr = ^EdInsStruct;
  95.  
  96.    MIinsStruct = record
  97.       Ver : Byte;               {Main version}
  98.       VerSub : Byte;            {Sub version}
  99.       VerPatch : Char;          {Patch level}
  100.       CPUmhz : Byte;            {CPU speed for delays}
  101.       CIstruct : CIptr;         {Points to CRT installation record}
  102.       EIstruct : EIptr;         {Points to Editor installation area}
  103.       DefExt : ASCIIZptr;       {Points to ASCIIZ default extension}
  104.    end;
  105.    MIptr = ^MIinsStruct;
  106.  
  107.    EdCB = object
  108.       constructor Init(
  109.           DataLen : Word;           {Size of binary editor workspace}
  110.           Cx1 : Byte;               {Editor window, upper left x 1..80}
  111.           Cy1 : Byte;               {Editor window, upper left y 1..25}
  112.           Cx2 : Byte;               {Editor window, lower right x 1..80}
  113.           Cy2 : Byte;               {Editor window, lower right y 1..25}
  114.           WaitForRetrace : Boolean; {True for snowy color cards}
  115.           Coptions : Word;          {Initial editor options}
  116.           DefExtension : string;    {Default file extension (must start with period)}
  117.           var ExitCommands;         {Commands to exit editor}
  118.           UserEventProcPtr: Pointer {Pointer to user event handler}
  119.           );
  120.         {-Innitialise an instance of the binary editor}
  121.         {Fails if not enough memmory is available     }
  122.       function   Read(Fname : string) : Word;
  123.         {-Read a file into the binary editor buffer space,
  124.           returning a status code}
  125.         {
  126.         Status codes -
  127.           0 = Successful read
  128.           1 = File not found, new file assumed
  129.           2 = File too large to edit
  130.         }
  131.       procedure  Reset;
  132.         {-Call the editor reset procedure}
  133.       function   Use(StartCommands : string) : Integer;
  134.         {-Edit file, using startcommands, and returning an exitcode}
  135.         {
  136.         Exit codes -
  137.          -1 = Editing terminated with ^KD
  138.           0 = Editing terminated with first user-specified exit command
  139.           1 ...
  140.         }
  141.       function   Modified : Boolean;
  142.         {-Return true if text buffer was modified during edit}
  143.       function   FileName : string;
  144.         {-Return the current file pathname of the specified control block}
  145.       procedure  ChangeName(fname : string);
  146.         {-rename pathname of the specified control block}
  147.       function   Save(MakeBackup : Boolean) : Word;
  148.         {-Save the current file in the editor text buffer,
  149.           returning a status code}
  150.         {
  151.         Status codes -
  152.           0 = Successful save
  153.           1 = File creation error
  154.           2 = Disk write error
  155.           3 = Error closing file
  156.         }
  157.       destructor Done;
  158.    private
  159.       x1, y1, x2, y2 : Byte;       {Upper left and lower right corners of editor window}
  160.       DataSeg        : Word;       {Segment address of editor data area}
  161.       DataSegLen     : Word;       {Requested data area length (bytes)}
  162.       Options        : Word;       {Bit flags for editor options}
  163.       FileStr        : ASCIIZptr;  {Points to ASCIIZ filename}
  164.       Commands       : ASCIIZptr;  {Points to ASCIIZ string of editor commands}
  165.       Reserved1      : ASCIIZptr;  {Not used here}
  166.       Reserved2      : ASCIIZptr;  {Not used here}
  167.       Event          : Pointer;    {Points to event handling procedure}
  168.       Buffer         : ^TextBuffer;{Points to text area}
  169.       BufSize        : Word;       {Available size for text}
  170.       MIstruct       : MIptr;      {Points to main installation record}
  171.       ComTab         : ASCIIZptr;  {Points to terminate command table}
  172.       EOtext         : Word;       {Current number of chars in text buffer}
  173.       CursorPos      : Word;       {Current cursor position in buffer}
  174.       BlockStart     : Word;       {Start of marked block in buffer}
  175.       BlockEnd       : Word;       {End of marked block in buffer}
  176.       Status         : Word;       {Editor status}
  177.       DataPtr        : ^TextBuffer;{Points to Turbo heap block allocated for text buffer}
  178.       Internals      : edintrec;   {points to internals}
  179.    end;
  180.  
  181. const
  182.    {CRT attributes for   normal low blk error}
  183.    MonoArray  : AttrArray = ($7,  $70, $F,  $F0);
  184.    BwArray    : AttrArray = ($7,  $70, $F,  $F0);
  185.    ColorArray : AttrArray = ($1F, $38, $71, $4F);
  186.  
  187. var
  188.    CurrInternals     : edintrecP;
  189.  
  190. procedure CRTputFast(x, y : Word; s : string);
  191. {-Use binary editor services to write a string to the screen}
  192. {x in 1..25, y in 1..80}
  193.  
  194. function ExpandPath(Fname : string) : string;
  195. {-Return a complete path using the binary editor services}
  196.  
  197. implementation
  198.  
  199. {$L BINED}
  200. procedure pAssign(var fromstr, tostr : ASCIIZ);  external;
  201. procedure cCrtPutf(var s : ASCIIZ; r, c : Word); external;
  202. procedure EditInit(var EdData);                  external;
  203. procedure EditNew(var EdData);                   external;
  204. function  Editor(var EdData) : Integer;          external;
  205.  
  206. var
  207.   UserEventAddr : Pointer;
  208.  
  209. {$L EVENT}
  210. procedure EventCheck(pinfo, peventno : Word); far; external;
  211.  
  212. function AsciizToStr(a : ASCIIZ) : string;
  213. var
  214.    s : string;
  215.    slen : Byte absolute s;
  216. begin
  217.    slen := 0;
  218.    while a[slen] <> #0 do
  219.      slen := Succ(slen);
  220.    Move(a, s[1], slen);
  221.    AsciizToStr := s;
  222. end;
  223.  
  224. procedure StrToAsciiz(s : string; var a : ASCIIZ);
  225. var
  226.    slen : Byte absolute s;
  227. begin                       {StrToAsciiz}
  228.    Move(s[1], a, slen);
  229.    a[slen] := #0;
  230. end;                        {StrToAsciiz}
  231.  
  232. procedure CRTputFast(x, y : Word; s : String);
  233. var
  234.    a : ASCIIZ;
  235. begin                       {CRTputFast}
  236.    {Create ASCIIZ string}
  237.    StrToAsciiz(s, a);
  238.    cCrtPutf(a, Pred(y), Pred(x));
  239. end;                        {CRTputFast}
  240.  
  241. function ExpandPath(Fname : String) : String;
  242. var
  243.     fromstr, tostr : ASCIIZ;
  244.  
  245.     function StupCase(s : string) : string;
  246.     var
  247.       i : Word;
  248.     begin                     {StupCase}
  249.       for i := 1 to Length(s) do
  250.         s[i] := UpCase(s[i]);
  251.       StupCase := s;
  252.     end;                      {StupCase}
  253.  
  254. begin                       {ExpandPath}
  255.    {Create ASCIIZ string from input}
  256.    StrToAsciiz(Fname, fromstr);
  257.    {Call the binary editor service}
  258.    pAssign(fromstr, tostr);
  259.    {Get Turbo string from Asciiz}
  260.    ExpandPath := StupCase(AsciizToStr(tostr));
  261. end;                        {ExpandPath}
  262.  
  263. constructor EdCB.Init(DataLen : Word; Cx1, Cy1, Cx2, Cy2 : Byte;
  264.                       WaitForRetrace : Boolean; Coptions : Word;
  265.                       DefExtension : String; var ExitCommands;
  266.                       UserEventProcPtr : Pointer);
  267.   {-Initialize the binary editor, returning a status code}
  268. var
  269.    nofs, bofs, codelen : Word;
  270. begin
  271.    {Initialize the editor control block}
  272.    DataSegLen := DataLen;
  273.    if MaxAvail < DataSegLen then begin
  274.       {Insufficient data space}
  275.       fail;
  276.    end;
  277.    GetMem(DataPtr, DataSegLen+15);
  278.    {Assure data space paragraph aligned}
  279.    if Ofs(DataPtr^) <> 0 then
  280.       DataSeg := Succ(Seg(DataPtr^))
  281.    else
  282.       DataSeg := Seg(DataPtr^);
  283.    x1 := Pred(Cx1);
  284.    x2 := Pred(Cx2);
  285.    y1 := Pred(Cy1);
  286.    y2 := Pred(Cy2);
  287.    Options := Coptions;
  288.    GetMem(FileStr, 72);    {Space for max length file string}
  289.    GetMem(Commands, 256);  {Room for 255 bytes of startup keystrokes}
  290.    FillChar(Commands^, 256, #0); {No startup commands right now}
  291.    GetMem(Reserved1, 8);      {Null out unused fields}
  292.    FillChar(Reserved1^, 8, #0);
  293.    Reserved2 := nil;
  294.    if UserEventProcPtr = nil then
  295.       {Disable event checking}
  296.       Event := nil
  297.    else begin
  298.       {Set up for user event checking}
  299.       Event := Addr(EventCheck);
  300.       UserEventAddr := UserEventProcPtr;
  301.    end;
  302.    Buffer := nil;          {Returned by Binary editor after initialization}
  303.    BufSize := 0;           {Returned by Binary editor after initialization}
  304.    {Allocate and initialize main installation area}
  305.    New(MIstruct);
  306.    with MIstruct^ do begin
  307.       Ver := 4;
  308.       VerSub := 0;
  309.       VerPatch := 'A';      {4.0A}
  310.       CPUmhz := 5;          {CPU speed in MHz - not critical}
  311.       New(CIstruct);
  312.       with CIstruct^ do begin
  313.          CRTtype := 1;
  314.          CRTx1 := 0;
  315.          CRTy1 := 0;
  316.          CRTx2 := 79;
  317.          CRTy2 := 24;        {Change to 42 for EGA 43 line mode}
  318.          CRTmode := $FF;     {Default screen mode}
  319.          if WaitForRetrace then
  320.             CRTsnow := $FF
  321.          else
  322.             CRTsnow := $0;
  323.          AttrMono := MonoArray;
  324.          AttrBW := BwArray;
  325.          AttrColor := ColorArray;
  326.       end;
  327.       EIstruct := nil;      {Command installation record set by Binary Editor}
  328.       GetMem(DefExt, 8);    {Default file extension}
  329.       StrToAsciiz(DefExtension, DefExt^);
  330.    end;
  331.    {Install special exitcommands}
  332.    ComTab := Addr(ExitCommands);
  333.    {Position and status variables used by editor}
  334.    EOtext := 0;
  335.    CursorPos := 0;
  336.    BlockStart := 0;
  337.    BlockEnd := 0;
  338.    Status := 0;
  339.    {Call the binary editor initialization procedure}
  340.    EditInit(x1);
  341.    internals.Find(self);
  342. end;                        {InitBinaryEditor}
  343.  
  344. function EdCB.Read(Fname : String) : Word;
  345. const
  346.    ctrlz = #26;
  347. var
  348.    f : file;
  349.    fsize : longint;
  350.    zpos, bytesread : Word;
  351. begin
  352.    Fname := ExpandPath(Fname);
  353.    StrToAsciiz(Fname, FileStr^);
  354.    {See whether file exists}
  355.    Assign(f, Fname);
  356.    system.Reset(f, 1);
  357.    if IOResult <> 0 then begin
  358.       {Couldn't open file, assume a new one}
  359.       EOtext := 0;
  360.       Buffer^[EOtext] := #0;
  361.       Read := 1;
  362.       Exit;
  363.    end;
  364.    {Check the file size}
  365.    fsize := FileSize(f);
  366.    if fsize > BufSize then begin
  367.       {File too big}
  368.       Read := 2;
  369.       Close(f);
  370.       Exit;
  371.    end;
  372.    {Read the file}
  373.    BlockRead(f, Buffer^, fsize, bytesread);
  374.    Close(f);
  375.    EOtext := fsize;
  376.    {Scan for control Z in last sector of file}
  377.    if EOtext < 512 then
  378.       zpos := 0
  379.    else
  380.       zpos := EOtext-512;
  381.    while zpos <> EOtext do
  382.       if Buffer^[zpos] = ctrlz then
  383.          EOtext := zpos
  384.       else
  385.          inc(zpos);
  386.    Buffer^[EOtext] := #0;
  387.    {Exit with success code}
  388.    Read := 0;
  389. end;
  390.  
  391. procedure EdCB.Reset;
  392. var junk : word;  {!!}
  393. begin
  394.    EditNew(x1);
  395. end;
  396.  
  397. function EdCB.Use(StartCommands : String) : Integer;
  398. begin                       {UseBinaryEditor}
  399.     CurrInternals := @Internals;
  400.     {Put the start commands into the editor control block}
  401.     if Length(StartCommands) > 0 then
  402.        Move(StartCommands[1], Commands^, Length(StartCommands));
  403.     {Call the editor}
  404.     Use := Editor(x1);
  405. end;                        {UseBinaryEditor}
  406.  
  407. function EdCB.Modified : Boolean;
  408. {-Return true if text buffer was modified during edit}
  409. begin                       {ModifiedFileBinaryEditor}
  410.    Modified := (Status and EdStatTextMod) <> 0;
  411. end;                        {ModifiedFileBinaryEditor}
  412.  
  413. function EdCB.FileName: String;
  414. {-Return the file name in the specified control block}
  415. begin                       {FileNameBinaryEditor}
  416.     FileName := AsciizToStr(FileStr^);
  417. end;                        {FileNameBinaryEditor}
  418.  
  419. procedure EdCB.ChangeName(fname : string);
  420. begin                       {FileNameBinaryEditor}
  421.    {Expand the pathname and store it in editor control block}
  422.    Fname := ExpandPath(Fname);
  423.    StrToAsciiz(Fname, FileStr^);
  424. end;
  425.  
  426. function EdCB.Save(MakeBackup : Boolean) : Word;
  427. {-Save the current file in the editor text buffer, returning a status code}
  428. var
  429.    f : file;
  430.    Fname : string;
  431.    i, byteswritten : Word;
  432.  
  433.    function Exist(Fname : string; var f : file) : Boolean;
  434.    {-Return true and assigned file handle if file exists}
  435.    var
  436.       i : Word;
  437.    begin                     {Exist}
  438.       Assign(f, Fname);
  439.       System.Reset(f);
  440.       Exist := (IOResult = 0);
  441.       Close(f);
  442.       {Clear ioresult}
  443.       i := IOResult;
  444.    end;                      {Exist}
  445.  
  446.    procedure MakeBakFile(NewName : string);
  447.    {-Make a backup file}
  448.    var
  449.       nf, bf : file;
  450.       BakName : string;
  451.       DotPos : Byte;
  452.       C : Char;
  453.  
  454.    begin                     {MakeBakFile}
  455.       if Exist(NewName, nf) then begin
  456.         {Workfile already exists, back it up}
  457.         {Find position of last period in NewName}
  458.         DotPos := Succ(Length(NewName));
  459.         repeat
  460.           dec(DotPos);
  461.           C := NewName[DotPos];
  462.         until (C = '.') or (C = '\') or (C = ':') or (DotPos = 0);
  463.         if (dotpos = 0) or (C <> '.') then
  464.           bakname := newname+'.BAK'
  465.         else
  466.           bakname := Copy(NewName, 1, dotpos)+'BAK';
  467.         if Exist(bakname, bf) then
  468.           {Backup already exists, erase it}
  469.           Erase(bf);
  470.         {Rename existing file to backup}
  471.         Rename(nf, bakname);
  472.       end;
  473.     end;                      {MakeBakFile}
  474.  
  475. begin                       {SaveFileBinaryEditor}
  476.    Fname := AsciizToStr(FileStr^);
  477.    if MakeBackup then
  478.       MakeBakFile(Fname);
  479.    Assign(f, Fname);
  480.    Rewrite(f, 1);
  481.    if IOResult <> 0 then begin
  482.       Save := 1;
  483.       Close(f);
  484.       i := IOResult;        {Clear ioresult}
  485.       Exit;
  486.    end;
  487.    BlockWrite(f, Buffer^, Succ(EOtext), byteswritten);
  488.    if (byteswritten <> Succ(EOtext)) or (IOResult <> 0) then begin
  489.       Save := 2;
  490.       Close(f);
  491.       Exit;
  492.    end;
  493.    Close(f);
  494.    if IOResult <> 0 then begin
  495.       Save := 3;
  496.       Exit;
  497.    end;
  498.    {Reset editor modified bit}
  499.    Status := 0;
  500.    {Success status}
  501.    Save := 0;
  502. end;
  503.  
  504. destructor edcb.done;
  505. {-Release heap space used by a binary editor control block}
  506. begin                       {ReleaseBinaryEditorHeap}
  507.     FreeMem(DataPtr, DataSegLen+15);
  508.     FreeMem(FileStr, 72);
  509.     FreeMem(Commands, 256);
  510.     FreeMem(Reserved1, 8);
  511.     Dispose(MIstruct^.CIstruct);
  512.     FreeMem(MIstruct^.DefExt, 8);
  513.     Dispose(MIstruct);
  514. end;
  515.  
  516. const
  517.   KbdStart = $1E;
  518.   KbdEnd   = $3C;
  519. type
  520.   Barray = array[0..30000] of Byte;
  521.   BarrayPtr = ^Barray;
  522.   SO =
  523.     record
  524.       O : Word;
  525.       S : Word;
  526.     end;
  527. var
  528.   KbdHead : Word absolute $40 : $1A;
  529.   KbdTail : Word absolute $40 : $1C;
  530.  
  531.   function Search(var Buffer; BuffLen : Word;
  532.                   var Match; MatchLen : Word) : Pointer;
  533.     {-Return pointer to start of match, nil if none}
  534.   var
  535.     B : BarrayPtr;
  536.     M : BarrayPtr;
  537.     I : Word;
  538.     J : Word;
  539.     Matched : Boolean;
  540.   begin
  541.     B := @Buffer;
  542.     M := @Match;
  543.     for I := 1 to BuffLen do begin
  544.       if B^[0] = M^[0] then begin
  545.         {Start of a match, try the rest}
  546.         if MatchLen = 1 then
  547.           Matched := True
  548.         else begin
  549.           J := 1;
  550.           repeat
  551.             Matched := (B^[J] = M^[J]);
  552.             Inc(J);
  553.           until not Matched or (J = MatchLen);
  554.         end;
  555.         if Matched then begin
  556.           {Complete match}
  557.           Search := B;
  558.           Exit;
  559.         end;
  560.       end;
  561.       {Move to next byte}
  562.       Inc(SO(B).O);
  563.     end;
  564.     {No match}
  565.     Search := nil;
  566.   end;
  567.  
  568.   function CodeMatch(B, M : BarrayPtr; Len : Word) : Boolean;
  569.     {-Return true if B^ matches M^ after discounting addresses}
  570.   var
  571.     MB : Byte;
  572.     I : Word;
  573.   begin
  574.     for I := 0 to Len-1 do begin
  575.       MB := M^[I];
  576.       if MB <> 0 then
  577.         if MB <> B^[I] then begin
  578.           CodeMatch := False;
  579.           Exit;
  580.         end;
  581.     end;
  582.     CodeMatch := True;
  583.   end;
  584.  
  585.   procedure EdintRec.Find(var EdD);
  586.     {-Initialize an internal data record}
  587.   type
  588.     WordPtr = ^Word;
  589.   const
  590.     {Code we must find to determine data offsets}
  591.     Match0 : array[0..7] of Byte =
  592.     ($C3,                         {RET}
  593.      $C3,                         {RET}
  594.      $F6, $06, $00, $00, $01,     {TEST [Options],01}
  595.      $C3);                        {RET}
  596.     Match1 : array[0..18] of Byte =
  597.     ($C6, $07, $1A,               {MOV BYTE PTR [BX],1Ah}
  598.      $8B, $16, $00, $00,          {MOV DX,[LineOfs]}
  599.      $2B, $16, $00, $00,          {SUB DX,[BuffOfs]}
  600.      $BE, $00, $00,               {MOV SI,StrtOfs}
  601.      $FC,                         {CLD}
  602.      $3B, $36, $00, $00);         {CMP SI,[CurrOfs]}
  603.     Match2 : array[0..7] of Byte =
  604.     ($5B,                         {POP BX}
  605.      $80, $3E, $00, $00, $FF,     {CMP [BufChar],$FF}
  606.      $B0, $FF);                   {MOV AL,$FF}
  607.   var
  608.     EdData : Edcb absolute EdD;
  609.     B0 : BarrayPtr;
  610.     B1 : BarrayPtr;
  611.     B2 : BarrayPtr;
  612.   begin
  613.     {All zeros will indicate error}
  614.     FillChar(self, SizeOf(self), 0);
  615.  
  616.     {B0 is base of the binary editor code segment}
  617.     B0 := Ptr(Seg(EditInit), 0);
  618.  
  619.     {Find code for editor options}
  620.     B0 := Search(B0^, 10000, Match0, 4);
  621.     if B0 = nil then
  622.       {Not found}
  623.       Exit;
  624.     if not CodeMatch(B0, @Match0, SizeOf(Match0)) then
  625.       {Not a complete match}
  626.       Exit;
  627.  
  628.     {Find code for various buffer offsets}
  629.     B1 := Search(B0^, 10000, Match1, 5);
  630.     if B1 = nil then
  631.       Exit;
  632.     if not CodeMatch(B1, @Match1, SizeOf(Match1)) then
  633.       Exit;
  634.  
  635.     {Find code for character buffer}
  636.     B2 := Search(B1^, 10000, Match2, 3);
  637.     if B2 = nil then
  638.       Exit;
  639.     if not CodeMatch(B2, @Match2, SizeOf(Match2)) then
  640.       Exit;
  641.  
  642.     {Initialize the internals record}
  643.     EditSeg := EdData.DataSeg;
  644.     BuffOfs := SO(EdData.Buffer).O;
  645.     OptnOfs := WordPtr(@B0^[4])^;
  646.     LineOfs := WordPtr(@B1^[5])^;
  647.     StrtOfs := WordPtr(@B1^[12])^;
  648.     CurrOfs := WordPtr(@B1^[17])^;
  649.     CharOfs := WordPtr(@B2^[3])^;
  650.   end;
  651.  
  652.   function Edintrec.CurrLineOfs : Word;
  653.     {-Return text buffer offset of start of current line}
  654.   begin
  655.     if EditSeg = 0 then
  656.        CurrLineOfs := $FFFF
  657.     else
  658.        CurrLineOfs := MemW[EditSeg:LineOfs]-BuffOfs;
  659.   end;
  660.  
  661.   function Edintrec.CurrChar : Char;
  662.     {-Return character at cursor position}
  663.   begin
  664.     if EditSeg = 0 then
  665.       CurrChar := #$FF
  666.     else
  667.       CurrChar := Char(Mem[EditSeg:MemW[EditSeg:CurrOfs]]);
  668.   end;
  669.  
  670.   function Edintrec.LinePos : Byte;
  671.     {-Return cursor position within current line}
  672.   begin
  673.     if EditSeg = 0 then
  674.       LinePos := $FF
  675.     else
  676.       LinePos := MemW[EditSeg:CurrOfs]-StrtOfs+1;
  677.   end;
  678.  
  679.   function Edintrec.LineLen : Byte;
  680.     {-Return length of current line}
  681.   var
  682.     O : Word;
  683.   begin
  684.     if EditSeg = 0 then
  685.       LineLen := $FF
  686.     else begin
  687.       O := StrtOfs+247;
  688.       while (O >= StrtOfs) and (Mem[EditSeg:O] = $20) do
  689.         Dec(O);
  690.       LineLen := O+1-StrtOfs;
  691.     end;
  692.   end;
  693.  
  694.   function Edintrec.CurrLine : string;
  695.     {-Return the current line as a string}
  696.   var
  697.     L : string;
  698.     LL : Byte absolute L;
  699.   begin
  700.     LL := LineLen;
  701.     if LL = $FF then
  702.       LL := 0
  703.     else
  704.       Move(Mem[EditSeg:StrtOfs], L[1], LL);
  705.     CurrLine := L;
  706.   end;
  707.  
  708.   function Edintrec.EditOptions : Byte;
  709.     {-Return the current editor options}
  710.   begin
  711.     if EditSeg = 0 then
  712.       EditOptions := $FF
  713.     else
  714.       EditOptions := Mem[EditSeg:OptnOfs];
  715.   end;
  716.  
  717.   procedure Edintrec.ClearKbd;
  718.     {-Clears both the BIOS and internal BINED keyboard buffers}
  719.   begin
  720.     if EditSeg <> 0 then begin
  721.       {Clear BIOS keyboard buffer}
  722.       KbdHead := KbdTail;
  723.       {Clear BINED character buffer}
  724.       Mem[EditSeg:CharOfs] := $FF;
  725.     end;
  726.   end;
  727.  
  728.   procedure Edintrec.StuffKey(W : Word);
  729.     {-Stuffs a keystroke into the keyboard buffer}
  730.   var
  731.     SaveKbdTail : Word;
  732.   begin
  733.     SaveKbdTail := KbdTail;
  734.     if KbdTail = KbdEnd then
  735.       KbdTail := KbdStart
  736.     else
  737.       Inc(KbdTail, 2);
  738.     if KbdTail = KbdHead then
  739.       {Buffer full, ignore request}
  740.       KbdTail := SaveKbdTail
  741.     else
  742.       MemW[$40:SaveKbdTail] := W;
  743.   end;
  744.  
  745. end.
  746. ________________________________________________________________________________
  747. {                          BINED.PAS
  748.                            BINED 4.0
  749.              Copyright (c) 1985, 87 by Borland International, Inc.            }
  750. {
  751.  BININT offers a way to access normally hidden information while within a
  752.  BINED event handler. See BININT.DOC for details. (follows)
  753.  
  754.  Written by Kim Kokkonen, TurboPower Software.
  755.  Released to the public domain.
  756.  Compuserve [72457,2131]
  757.  
  758.  Version 1.0, 10/22/88
  759.    first release
  760. }
  761.                                 BININT
  762.           Accessing BINED Internal Information in Event Handlers
  763.                              Version 1.0
  764.                              Kim Kokkonen
  765.  
  766. Overview
  767. ------------------------------------------------------------------------------
  768. BININT is a small unit that may be used in programs based on the binary
  769. editor, BINED, from Borland's Editor Toolbox. It removes a drawback of BINED,
  770. which is that accurate information about the cursor position (within the
  771. current line and text buffer) is not available to event handlers. As such,
  772. event handlers are limited in what they can do.
  773.  
  774. When accurate information is available to a BINED event handler, new
  775. horizons open up for using the binary editor. We developed this unit in
  776. order to add limited mouse support to BINED, which required knowing the
  777. cursor position relative to the overall file size. Another popular request
  778. is to add word-wrap to BINED -- knowing the information provided by BININT, an
  779. event handler could be written to add word wrap.
  780.  
  781. BININT is a dirty little unit, peeking into the BINED code segment to read
  782. certain offsets of data items that it needs to compute accurate information
  783. for use by an event handler. Even so, BININT is very careful to assure that
  784. the information it uses is correct. If BININT can't find the appropriate
  785. offsets, it will fail gracefully, but in this case an event handler won't
  786. have the information it needs. So far this isn't much of a concern since to
  787. our knowledge Borland has released only a single version of BINED. BININT is
  788. designed to adjust itself automatically whenever possible, even if BINED is
  789. changed in the future.
  790.  
  791. In the following, we assume you know what is meant by a BINED "event handler".
  792. See Borland's documentation, or the supplied example TEST.PAS, for background.
  793.  
  794.  
  795. Using BININT
  796. ------------------------------------------------------------------------------
  797. Just add BININT to your USES list, after BINED itself. (BININT depends on
  798. BINED.) Then your application can call any of the following procedures and
  799. functions.
  800.  
  801. procedure FindInternals(EdData : EdCB; var E : EdIntRec);
  802.  
  803.   Call FindInternals any time after calling Borland's InitBinaryEditor
  804.   routine, but before calling UseBinaryEditor. This routine initializes the
  805.   record parameter E to hold information needed to track the specified edit
  806.   window EdData. The program must declare a global variable of type EdIntRec
  807.   to store the binary editor internals information for use by the event
  808.   handler. Note that you will need a separate EdIntRec variable for each
  809.   BINED edit window.
  810.  
  811.   If for some reason BININT cannot find the appropriate locations in BINED, it
  812.   will return all fields of the EdIntRec set to zero. This may be considered
  813.   a critical error for any program using BININT even though the rest of
  814.   BININT's functions are designed to return safe values in this case. You can
  815.   test for correct operation of FindInternals with the following statement:
  816.  
  817.     if E.EditSeg = 0 then
  818.       {Critical error, unknown BINED version} ;
  819.  
  820. The remaining BININT functions are intended for use within an event handler.
  821. Each of them requires a parameter of type EdIntRec, previously initialized by
  822. a call to FindInternals.
  823.  
  824. function CurrLineOfs(var E : EdIntRec) : Word;
  825.  
  826.   This routine returns the byte offset within BinEd's text buffer of the first
  827.   character on the current line. For example, if the cursor is on the first
  828.   line of a text file, CurrLineOfs will return 0. If the first line has 10
  829.   characters (counting CR and LF), then CurrLineOfs will return 10 when the
  830.   cursor is on the second line of the file. When the cursor is moved to the
  831.   end of the file, CurrLineOfs returns the same value as EdData.EOtext. If the
  832.   EdIntRec was not correctly initialized, CurrLineOfs returns $FFFF.
  833.  
  834.   Note that CurrLineOfs does not vary when the cursor is moved within a given
  835.   line. The LinePos function provides that information.
  836.  
  837. function CurrChar(var E : EdIntRec) : Char;
  838.  
  839.   CurrChar returns the ASCII character associated with the current cursor
  840.   position in the file. If the cursor is beyond the end of the current line,
  841.   CurrChar returns a blank (#32). CurrChar will not return a CR (#13), LF
  842.   (#10), or EOF (#26) unless the text file is corrupt. If the EdIntRec was not
  843.   correctly initialized, CurrChar returns #255.
  844.  
  845. function LinePos(var E : EdIntRec) : Byte;
  846.  
  847.   LinePos returns the position of the cursor in the current line. It returns 1
  848.   for the first character in the line. The highest value normally returned
  849.   will be 249. If the EdIntRec was not correctly initialized, LinePos returns
  850.   255.
  851.  
  852.   Note that you can't add LinePos to CurrLineOfs and obtain an offset that
  853.   means anything. BINED copies the current line to a separate buffer for
  854.   editing and recopies it to the main text buffer only when the cursor leaves
  855.   the line. Hence, the contents of the text buffer beyond CurrLineOfs are not
  856.   guaranteed to be up to date. Use the CurrLine function to get the contents
  857.   of the current text line.
  858.  
  859. function LineLen(var E : EdIntRec) : Byte;
  860.  
  861.   Returns the length of the current line. The length is defined as the number
  862.   of characters up to and including the last non-blank character in the line.
  863.   Note that the cursor is allowed to move beyond this position, and thus you
  864.   will have situations where LinePos > LineLen. If the EdIntRec was not
  865.   correctly initialized, LineLen returns 255.
  866.  
  867. function CurrLine(var E : EdIntRec) : string;
  868.  
  869.   Returns the current text line as a string. There's no need to call LineLen
  870.   if you call CurrLine since the length of the returned string equals LineLen.
  871.   If the EdIntRec was not correctly initialized, CurrLine returns an empty
  872.   string.
  873.  
  874. function EditOptions(var E : EdIntRec) : Byte;
  875.  
  876.   Returns the current value of the editor options (which may have been changed
  877.   by the user since the edit session started). See the constants near the top
  878.   of BINED.PAS (EdOptInsert and so on) for masks to decode this bit-mapped
  879.   byte.
  880.  
  881. Note that BININT is not designed to let you _modify_ any of the data that it
  882. provides. Within an event handler, it is not safe to change the cursor
  883. position, or directly modify the line buffer.
  884.  
  885. If modification of the text stream is desired (as would be the case when
  886. adding word wrap to BINED), the appropriate action is to poke characters into
  887. the keyboard buffer. For this reason, BININT provides two more procedures:
  888.  
  889. procedure ClearKbd(var E : EdIntRec);
  890.  
  891.   Before poking a character, it is best to call this routine. ClearKbd clears
  892.   not only the BIOS keyboard buffer, but also an internal single byte buffer
  893.   used by BINED to hold extended keystrokes.
  894.  
  895. procedure StuffKey(W : Word);
  896.  
  897.   This stuffs one character (ASCII value with scan code) into the keyboard
  898.   buffer. If the character is not extended (like <F1> or <Left>) it is alright
  899.   to call StuffKey as follows:
  900.  
  901.     StuffKey(Ord(CharToStuff));
  902.  
  903.   For example
  904.  
  905.     StuffKey(Ord(^M));
  906.  
  907.   puts a carriage return into the keyboard buffer, to be acted upon by BINED
  908.   when the event handler returns.
  909.  
  910.   For an extended character, pass the appropriate word value. For example
  911.  
  912.     StuffKey($4B00);
  913.  
  914.   stuffs a <Left> arrow into the keyboard buffer.
  915.  
  916.   Remember that the keyboard buffer normally holds only 16 characters. If the
  917.   buffer is full when StuffKey is called, it does nothing.
  918.  
  919.  
  920. Examples
  921. ------------------------------------------------------------------------------
  922. The supplied program TEST1.PAS is a tiny example of using BININT. It allows
  923. you to browse through a file while continuously showing a status report of the
  924. information offered by BININT. Just compile TEST1.PAS and run it by specifying
  925. a text file to browse on the command line:
  926.  
  927.    TEST1 FileToBrowse
  928.  
  929. Press ^KD to quit. No changes will be saved.
  930.  
  931. TEST2 is a frivolous example of modifying the text stream by stuffing
  932. characters into the keyboard buffer. Compile and run it just like TEST1. In
  933. TEST2, whenever the cursor is positioned over a space within a text line, the
  934. event handler breaks the text onto the next line, leading to a
  935. semi-interactive "one word per line" filter. If the editor is in overwrite
  936. mode, the event handler does nothing. Like TEST1, TEST2 does not allow you to
  937. save the resulting file.
  938.  
  939.  
  940. Disclaimer
  941. ------------------------------------------------------------------------------
  942. The BININT unit was written by Kim Kokkonen of TurboPower Software. It is
  943. hereby released to the public domain. We accept no liability for the use of
  944. this software, and make no guarantees as to its performance. Good luck! We'd
  945. like to hear from the first person to develop a word-wrapping event handler
  946. for BINED.
  947.  
  948.